perm filename FOR01.DAT[NEW,LCS] blob sn#165251 filedate 1975-06-21 generic text, type T, neo UTF8
00100	60	J2=R2
00200		RSTJ2=RSTFAC(J2)
00300	CL	RD=0
00400		IF(JA.NE.2)GO TO 163
00500		IF(R9.EQ.0)GO TO 163
00600		K=ITEM
00700	C  ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
00800		IF(X22.NE.0)K=X22-1
00805		RD=1.75*RSTJ2
00810		L=PWDS(K+2)
00815		IF(RN(L+1).NE.4)GO TO 164
00817	C  GO ON IF NEXT ISN'T BAR LINE (CODE 4. COULD FIND OTHER LINES!!)
00820		RB=RN(L+3)
00830		L=PWDS(K)
00840	C  CHECK PREV. AND NEXT ITEM.  IF NOT BAR, DON'T TRY TO CENTER!
00860		IF(RN(L+1).NE.4)GO TO 164
00960		RA=RN(L+3)
01200		R3=RA+(RB-RA)/2-1.75*RSTJ2
01300	164	IF(PLT.EQ.0)GO TO 160 
01400		RN(IFIX(PWDS(K+1))+3)=R3
01500	C  ******* A DANGEROUS PLACE.  KEEP TRACK OF THIS
01600		GO TO 5541
01700	
01800	163	IF(JA.EQ.16)GO TO 63
01900		IF(PLT.NE.0)GO TO 5541
02000		IF(JA.NE.8)GO TO 70
02100		IF(R9.NE.1)GO TO 70
02200		R9=RN(MEDIT+9)
02300		IF(R9.NE.' ')TYPE 427,R9
02400		TYPE 21
02500		ACCEPT FA5,R9
02600		IF(R9.EQ.LY(1))R9=0
02700	C  WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
02800	70	IF(JA.NE.11)GO TO 160
02900	C  ↑↑↑↑ WAS - TO 63
03000		IF(J10.NE.1)GO TO 62
03100		TYPE 21
03200		ACCEPT FA5,NJR
03300	C   P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
03400		LASTNM=NJR
03500	62	IF(NJR.EQ.0)NJR=LASTNM
03600	C  IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
03700		GO TO 160
03800	CC63	IF(JA.EQ.50)JA=16
03900	C  ABOVE SHOULD BE TAKEN OUT AT SOME FUTURE DATE. (12/73)
04000	CL63	IF(R3.LT.1000)GO TO 66
04100	CL	RD=R3
04200	CL	IF(JA.EQ.5)R13=R3/1000.
04300	CL	CALL RNOTE(R3)
04400	C IF R3>1000 IT FINDS TRUE R3 THROUGH NOTE NUMB.
04500	CL66	IF(JA.NE.16)GO TO 160
04600	CX63	IF(JA.NE.16)GO TO 160
04700	C  USE P10≠0 TO LINK UP TEXT.
04800	CCZZZZZZ	IF(J10.EQ.0.OR.PLT.NE.0)GO TO 160
04900	63	IF(J10.EQ.0)GO TO 162
05000	CX	R10=0
05100		L=ITEM
05200		IF(X22.NE.0)L=X22-1
05300		IF(J10.EQ.1)GO TO 263
05400	C NEXT FOR CENTERING OF TEXT.  P10>1
05500		RB=0
05600		X=PWDS(L+1)
05700	363	L=L+1
05800		K=PWDS(L)
05900		RB=RB+RN(K+9)
06000	C  ADD SPACE NEEDED
06100		K=PWDS(L+1)
06200		IF(RN(K+1).NE.16)GO TO 463
06300		IF(RN(K).EQ.8)GO TO 363
06400	C GO BACK IF MORE LETTERS TO COME
06500	463	R3=R10-(RB-3.4)*R5*RSTJ2/2.
06600	C  +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
06700		R10=0
06800		IF(RN(X).EQ.8)RN(X+10)=0
06900		RN(X+3)=R3
07000	C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
07100		GO TO 162
07200	263	K=PWDS(L)
07300		R3=R5*RSTJ2*RN(K+9)+RN(K+3)
07400		RN(IFIX(PWDS(L+1))+3)=R3
07500	C  PUTS POS. BACK INTO RN ARRAY EVERY TIME.
07600	C  PUTS 13TH(+) LETTER IN RIGHT POS. 
07700	162	IF(PLT.NE.0)GO TO 5541
07800	CX160	IF(EDX.NE.0)GO TO 162
07900	CP	IF(I1.EQ.IP)GO TO 5541
08000	CX162	RJ3=R3
08100	160	RJ3=R3
08200		JJA=JA
08300		IF(R8.NE.0)GO TO 161
08400		IF(JA.EQ.1)R8=999.
08500	C  999=0 FOR STEM EXTENSIONS.
08600	CL161	CNT=1
08700	CL	DO 5543 K=1,9
08800	C  10/6/73 ABOVE WAS ,11
08900	CL	RA=RJQ(K)
09000	CL	IF(RA.NE.0)CNT=K
09100	CL5543	RJJ(K)=RA
09200	C  USES ONLY 10 PARAMETERS BEYOND JA, J2
09300	161	CALL MSSLUP
09400	CP2554	IF(PLT.NE.0)GO TO 5541
09500		IF(JA.EQ.6)CALL HOMER
09600		IF(JA.NE.13)GO TO 1261
09700		IF(J6.NE.0)R13=-1
09800	
09900	1261	IF(R13.EQ.0)GO TO 261
10000		CALL HOMER
10100		IF(JA.EQ.10)R3=R3+RSTJ2
10200	C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
10300	C  IF P13≠0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
10400	C **** FOR '0' EDITS ******
10500	CL261	RN(I)=CNT
10600	CL	RN(I+1)=JA
10700	CL	I=I+2
10800	CL	RN(I)=R2
10900	CL	IF(RD.NE.0)RN(I)=RD
11000	C TO SAVE NOTE NUMBS IN P2.
11100	CL	DO 4554 K=1,CNT
11200	CL4554	RN(I+K)=RJQ(K)
11300	CL3554	I=CNT+1+I
11400	261	CALL LUP2